home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / graphics.swg / 0101_3D Rotation Objects.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-24  |  7.8 KB  |  362 lines
  1.  
  2. { Here is a program to rotate any object in 3D. }
  3.  
  4. (********************************************************
  5.  * This program was written by David Rozenberg          *
  6.  *                                                      *
  7.  * The program show how to convert a 3D point into a 2D *
  8.  * plane like the computer screen. So it will give you  *
  9.  * the illusion of 3D shape.                            *
  10.  *                                                      *
  11.  * You can rotate it by the keyboard arrows, for nonstop*
  12.  * rotate press Shift+Arrow                             *
  13.  *                                                      *
  14.  * Please use the program as it is without changing it. *
  15.  *                                                      *
  16.  * Usage:                                               *
  17.  *   3D FileName.Ext                                    *
  18.  *                                                      *
  19.  * There are some files for example how to build them   *
  20.  * the header " ; 3D by David Rozenberg " must be at the*
  21.  * beging of the file.                                  *
  22.  *                                                      *
  23.  ********************************************************)
  24.  
  25. Program G3d;
  26. {$E+,N+}
  27. Uses
  28.  Crt,Graph;
  29.  
  30. Type
  31.   Coordinate = Array[1..7] of Real;
  32.   Point = Record
  33.             X,Y,Z : Real;
  34.           End;
  35.   LineRec = ^LineType;
  36.   LineType = Record
  37.                FPoint,TPoint : Point;
  38.                Color : Byte;
  39.                Next  : LineRec;
  40.              End;
  41.  
  42.  
  43. Var
  44.   FirstLine : LineRec;
  45.   Last      : LineRec;
  46.  
  47. Procedure Init;
  48. Var
  49.   GraphDriver,GraphMode,GraphError : Integer;
  50.  
  51. Begin
  52.   GraphDriver:=Detect;
  53.   initGraph(GraphDriver,GraphMode,'\turbo\tp');  { your BGI driver address }
  54.   GraphError:=GraphResult;
  55.   if GraphError<>GrOk then begin
  56.     clrscr;
  57.     writeln('Error while turning to graphics mode.');
  58.     writeln;
  59.     halt(2);
  60.   end;
  61. End;
  62.  
  63.  
  64. Function DegTRad(Deg : Real) : real;
  65. Begin
  66.   DegTRad:=Deg/180*Pi;
  67. End;
  68.  
  69. Procedure ConvertPoint (P : Point;Var X,Y : Integer);
  70. Var
  71.   Dx,Dy : Real;
  72.  
  73. Begin
  74.   X:=GetMaxX Div 2;
  75.   Y:=GetMaxY Div 2;
  76.   Dx:=(P.Y)*cos(pi/6);
  77.   Dy:=-(P.Y)*Sin(Pi/6);
  78.   Dx:=Dx+(P.X)*Cos(pi/3);
  79.   Dy:=Dy+(P.X)*Sin(Pi/3);
  80.   Dy:=Dy-P.Z;
  81.   X:=X+Round(Dx);
  82.   Y:=Y+Round(Dy);
  83. End;
  84.  
  85. Procedure DrawLine(Lrec : LineRec);
  86. Var
  87.   Fx,Fy,Tx,Ty : Integer;
  88.  
  89. Begin
  90.   SetColor(Lrec^.Color);
  91.   ConvertPoint(LRec^.FPoint,Fx,Fy);
  92.   ConvertPoint(LRec^.TPoint,Tx,Ty);
  93.   Line(Fx,Fy,Tx,Ty);
  94. End;
  95.  
  96. Procedure ShowLines;
  97. Var
  98.   Lp : LineRec;
  99.  
  100. Begin
  101.   ClearDevice;
  102.   Lp:=FirstLine;
  103.   While Lp<>Nil do Begin
  104.     DrawLine(Lp);
  105.     Lp:=Lp^.Next;
  106.   end;
  107. End;
  108.  
  109. Procedure Error(Err : Byte;S : String);
  110. Begin
  111.   Clrscr;
  112.   Writeln;
  113.   Case Err of
  114.     1 : Writeln('File : ',S,' not found!');
  115.     2 : Writeln(S,' isn''t a 3d file!');
  116.     3 : Writeln('Error in line :',S);
  117.     4 : Writeln('No file was indicated');
  118.   End;
  119.   Writeln;
  120.   Halt(Err);
  121. End;
  122.  
  123. Procedure AddLine(Coord : Coordinate);
  124. Var
  125.   Lp : LineRec;
  126.  
  127. Begin
  128.   New(Lp);
  129.   Lp^.Color:=Round(Coord[7]);
  130.   Lp^.FPoint.X:=Coord[1];
  131.   Lp^.FPoint.Y:=Coord[2];
  132.   Lp^.FPoint.Z:=Coord[3];
  133.   Lp^.TPoint.X:=Coord[4];
  134.   Lp^.TPoint.Y:=Coord[5];
  135.   Lp^.TPoint.Z:=Coord[6];
  136.   Lp^.Next:=Nil;
  137.   If Last=Nil then FirstLine:=Lp else Last^.Next:=Lp;
  138.   Last:=Lp;
  139. end;
  140.  
  141. Procedure LoadFile(Name : String);
  142. Var
  143.   F : Text;
  144.   Coord : Coordinate;
  145.   S,S1 : String;
  146.   I : Byte;
  147.   LineNum : Word;
  148.   Comma : Integer;
  149.  
  150. Begin
  151.   FirstLine:=Nil;
  152.   Last:=Nil;
  153.   Assign(F,Name);
  154.   {$I-}
  155.   Reset(f);
  156.   {$I+}
  157.   If IoResult<>0 then Error(1,Name);
  158.   Readln(F,S);
  159.   If S<>'; 3D by David Rozenberg' then Error(2,Name);
  160.   LineNum:=1;
  161.   While Not Eof(F) do Begin
  162.     Inc(LineNum);
  163.     Readln(F,S);
  164.     while Pos(' ',S)<>0 do Delete(S,Pos(' ',S),1);
  165.     If (S<>'') and (S[1]<>';') then begin
  166.       For I:=1 to 6 do Begin
  167.         Comma:=Pos(',',S);
  168.         If Comma=0 then Begin
  169.           Close(F);
  170.           Str(LineNum:4,S);
  171.           Error(3,S);
  172.         End;
  173.         S1:=Copy(S,1,Comma-1);
  174.         Delete(S,1,Comma);
  175.         Val(S1,Coord[i],Comma);
  176.         If Comma<>0 then Begin
  177.           Close(F);
  178.           Str(LineNum:4,S);
  179.           Error(3,S);
  180.         End;
  181.       End;
  182.       Val(S,Coord[7],Comma);
  183.       If Comma<>0 then Begin
  184.         Close(F);
  185.         Str(LineNum:4,S);
  186.         Error(3,S);
  187.       End;
  188.       AddLine(Coord);
  189.     End;
  190.   End;
  191.   Close(F);
  192. End;
  193.  
  194. Procedure RotateZ(Deg : Real);
  195. Var
  196.   Lp : LineRec;
  197.   Rad : Real;
  198.   Tx,Ty : Real;
  199.  
  200. Begin
  201.   Rad:=DegTRad(Deg);
  202.   Lp:=FirstLine;
  203.   While Lp<>Nil do Begin
  204.     With Lp^.Fpoint Do Begin
  205.       TX:=(X*Cos(Rad)-Y*Sin(Rad));
  206.       TY:=(X*Sin(Rad)+Y*Cos(Rad));
  207.       X:=Tx;
  208.       Y:=Ty;
  209.     End;
  210.     With Lp^.Tpoint Do Begin
  211.       TX:=(X*Cos(Rad)-Y*Sin(Rad));
  212.       TY:=(X*Sin(Rad)+Y*Cos(Rad));
  213.       X:=Tx;
  214.       Y:=Ty;
  215.     End;
  216.     Lp:=Lp^.Next;
  217.   end;
  218. End;
  219.  
  220. Procedure RotateY(Deg : Real);
  221. Var
  222.   Lp : LineRec;
  223.   Rad : Real;
  224.   Tx,Tz : Real;
  225.  
  226. Begin
  227.   Rad:=DegTRad(Deg);
  228.   Lp:=FirstLine;
  229.   While Lp<>Nil do Begin
  230.     With Lp^.Fpoint Do Begin
  231.       TX:=(X*Cos(Rad)-Z*Sin(Rad));
  232.       TZ:=(X*Sin(Rad)+Z*Cos(Rad));
  233.       X:=Tx;
  234.       Z:=Tz;
  235.     End;
  236.     With Lp^.Tpoint Do Begin
  237.       TX:=(X*Cos(Rad)-Z*Sin(Rad));
  238.       TZ:=(X*Sin(Rad)+Z*Cos(Rad));
  239.       X:=Tx;
  240.       Z:=Tz;
  241.     End;
  242.     Lp:=Lp^.Next;
  243.   end;
  244. End;
  245.  
  246. Procedure Rotate;
  247. Var
  248.   Ch : Char;
  249.  
  250. Begin
  251.   Repeat
  252.     Repeat
  253.       Ch:=Readkey;
  254.       If ch=#0 then Ch:=Readkey;
  255.     Until Ch in [#27,#72,#75,#77,#80,#50,#52,#54,#56];
  256.     Case ch of
  257.       #54 :Begin
  258.               While Not keypressed do begin
  259.                 RotateZ(10);
  260.                 ShowLines;
  261.                 Delay(100);
  262.               End;
  263.               Ch:=Readkey;
  264.               If Ch=#0 then Ch:=ReadKey;
  265.             End;
  266.       #52:Begin
  267.               While Not keypressed do begin
  268.                 RotateZ(-10);
  269.                 ShowLines;
  270.                 Delay(100);
  271.               End;
  272.               Ch:=Readkey;
  273.               If Ch=#0 then Ch:=ReadKey;
  274.             End;
  275.       #56:Begin
  276.               While Not keypressed do begin
  277.                 RotateY(10);
  278.                 ShowLines;
  279.                 Delay(100);
  280.               End;
  281.               Ch:=Readkey;
  282.               If Ch=#0 then Ch:=ReadKey;
  283.             End;
  284.       #50:Begin
  285.               While Not keypressed do begin
  286.                 RotateY(-10);
  287.                 ShowLines;
  288.                 Delay(100);
  289.               End;
  290.               Ch:=Readkey;
  291.               If Ch=#0 then Ch:=ReadKey;
  292.             End;
  293.       #72 : Begin
  294.               RotateY(10);
  295.               ShowLines;
  296.             End;
  297.       #75 : Begin
  298.               RotateZ(-10);
  299.               ShowLines;
  300.             End;
  301.       #77 : Begin
  302.               RotateZ(10);
  303.               ShowLines;
  304.             End;
  305.       #80 : Begin
  306.               RotateY(-10);
  307.               ShowLines;
  308.             End;
  309.     End;
  310.   Until Ch=#27;
  311. End;
  312.  
  313. Begin
  314.   If ParamCount<1 then Error(4,'');
  315.   LoadFile(ParamStr(1));
  316.   Init;
  317.   ShowLines;
  318.   Rotate;
  319.   CloseGraph;
  320.   ClrScr;
  321.   Writeln;
  322.   Writeln('Thanks for using 3D');
  323.   Writeln;
  324. End.
  325.  
  326. There is sample of some files that can be rotated:
  327. cut out and save in specified file name
  328. Cube.3D:
  329.  
  330. ; 3D by David Rozenberg
  331. ; Base of cube
  332. -70,70,-70,70,70,-70,15
  333. 70,70,-70,70,-70,-70,15
  334. 70,-70,-70,-70,-70,-70,15
  335. -70,-70,-70,-70,70,-70,15
  336. ; Top of cube
  337. -70,70,70,70,70,70,15
  338. 70,70,70,70,-70,70,15
  339. 70,-70,70,-70,-70,70,15
  340. -70,-70,70,-70,70,70,15
  341. ; Side of cube
  342. -70,70,-70,-70,70,70,13
  343. 70,70,-70,70,70,70,13
  344. 70,-70,-70,70,-70,70,13
  345. -70,-70,-70,-70,-70,70,13
  346.  
  347. David.3D:
  348.  
  349. ; 3D by David Rozenberg
  350. 0,-120,45,0,-30,45,15
  351. 0,-60,45,0,-60,-45,15
  352. ; 
  353. 0,-15,45,0,15,45,12
  354. 0,15,45,0,15,-45,12
  355. ;
  356. 0,30,45,0,120,45,11
  357. 0,90,45,0,90,-45,11
  358. ;
  359. 50,-45,-75,50,45,-75,10
  360. 50,45,-75,50,45,-165,10
  361.  
  362.